home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / painter.arc / PAINTER.BAS
Encoding:
BASIC Source File  |  1985-10-19  |  17.3 KB  |  372 lines
  1. 10 'PICTURE PAINTER v1.4d    -Copyright 1984, MBH Software Systems
  2. 15 SCREEN 0
  3. 20 CLEAR ,,2048:KEY OFF:CLS:PSTART%=1
  4. 25 FOR X = 1 TO 10 : KEY X,"": NEXT
  5. 30 WIDTH 80: COLOR 7,0:ESCFLAG=0:LOCATE 24,56:PRINT "Press any key to begin.";
  6. 40 COLOR 12:SCOL = 3:WORDL$="Picture ":WORDR$="Painter":GOSUB 130
  7. 50 IF ESCFLAG=1 THEN 120
  8. 60 COLOR 2:SCOL = 6:WORDL$="Version ":WORDR$=" 1.4d":GOSUB 130
  9. 70 IF ESCFLAG=1 THEN 120
  10. 80 COLOR 6:SCOL = 18:WORDL$="Copyright":WORDR$=" 1984,":GOSUB 130
  11. 90 IF ESCFLAG=1 THEN 120
  12. 100 COLOR 15:SCOL = 20:WORDL$="MBH  Soft":WORDR$="ware Systems":GOSUB 130
  13. 110 CMD$=INKEY$:IF CMD$="" THEN 110  
  14. 120 GOTO 470
  15. 130 'Subroutine for jazzed up screen display.
  16. 140 FOR I=1 TO SCOL-1
  17. 150   CMD$=INKEY$:IF CMD$<>"" THEN ESCFLAG=1:RETURN
  18. 160   LOCATE I,1
  19. 170   PRINT SPACE$(LEN(WORDL$));
  20. 180   LOCATE I,80-LEN(WORDR$)
  21. 190   PRINT SPACE$(LEN(WORDR$));
  22. 200   LOCATE I+1,1
  23. 210   PRINT WORDL$;
  24. 220   LOCATE I+1,80-LEN(WORDR$)
  25. 230   PRINT WORDR$;
  26. 240 NEXT I
  27. 250 LSTOP = (80-(LEN(WORDL$)+LEN(WORDR$)+1))\2
  28. 260 RSTOP = LSTOP + LEN(WORDL$)
  29. 270 IF LSTOP > 80-RSTOP THEN MOVEIT = LSTOP ELSE MOVEIT = 80-RSTOP
  30. 280 FOR I = 1 TO MOVEIT
  31. 290 CMD$=INKEY$:IF CMD$<>"" THEN ESCFLAG=1:RETURN
  32. 300   IF I > LSTOP THEN 330
  33. 310     LOCATE SCOL,I
  34. 320     PRINT WORDL$;
  35. 330  IF 80-(LEN(WORDR$)-1+I) < RSTOP THEN 360
  36. 340    LOCATE SCOL,80-(LEN(WORDR$)-1+I)
  37. 350    PRINT WORDR$;
  38. 360 NEXT I
  39. 370 FOR I = 1 TO MOVEIT
  40. 380 CMD$=INKEY$:IF CMD$<>"" THEN ESCFLAG=1:RETURN
  41. 390  IF I > LSTOP-1 THEN 420
  42. 400    LOCATE SCOL,I
  43. 410    PRINT " ";
  44. 420  IF 80-I < RSTOP+LEN(WORDR$) THEN 450
  45. 430    LOCATE SCOL,(80-I)
  46. 440    PRINT " ";
  47. 450 NEXT I
  48. 460 RETURN
  49. 470 'Ask if help is needed
  50. 480 CLS:COLOR 15:LOCATE 12,20:PRINT "Would you like to see the INSTRUCTION SCREEN"
  51. 490 SROW=12:SCOL=66:MAX=1:GOSUB 3430
  52. 500 IF DAT$="Y" THEN 1250
  53. 510 PSTART%=0
  54. 520 'Begin program here.
  55. 530 BACKCOLOR=8:PALETTE=0:TEXTMODEFLAG=0:ALTKEY$="":BORDERCOL=1
  56. 540 DIM STORARY%(194),BEFPLEFT%(3962),BEFPRIGHT%(3962),SAVEBLOCK%(5):KOPY=0
  57. 550 SCREEN 1,0:COLOR BACKCOLOR,PALETTE,0
  58. 560 CLS:LINE (0,0)-(319,199),BORDERCOL,B
  59. 570 XX=160:YY=100:OLDXX=160:OLDYY=100:LASTXX=0:LASTYY=0:DDRAW=0:CUSCOL=1
  60. 580 '  INITIALIZE BEFPAINT VARIABLE.
  61. 590 GET (1,1)-(159,198),BEFPLEFT% : GET (160,1)-(318,198),BEFPRIGHT%
  62. 600 BEFCOLOR = POINT(XX,YY)
  63. 610 CMD$=INKEY$:IF CMD$="" THEN POKE 23,(PEEK(23) AND 223):GOTO 610
  64. 620 IF MID$(CMD$,2,1) = "K" THEN XX=XX-1:GOTO 1010
  65. 630 IF MID$(CMD$,2,1) = "M" THEN XX=XX+1:GOTO 1010
  66. 640 IF MID$(CMD$,2,1) = "s" THEN XX=XX-5:GOTO 1010
  67. 650 IF MID$(CMD$,2,1) = "t" THEN XX=XX+5:GOTO 1010
  68. 660 IF MID$(CMD$,2,1) = "P" THEN YY=YY+1:GOTO 1010
  69. 670 IF MID$(CMD$,2,1) = "H" THEN YY=YY-1:GOTO 1010
  70. 680 IF MID$(CMD$,2,1) = "u" THEN YY=YY+5:GOTO 1010
  71. 690 IF MID$(CMD$,2,1) = "w" THEN YY=YY-5:GOTO 1010
  72. 700 IF MID$(CMD$,2,1) = "G" THEN YY=YY-1:XX=XX-1:GOTO 1010
  73. 710 IF MID$(CMD$,2,1) = "O" THEN YY=YY+1:XX=XX-1:GOTO 1010
  74. 720 IF MID$(CMD$,2,1) = "I" THEN YY=YY-1:XX=XX+1:GOTO 1010
  75. 730 IF MID$(CMD$,2,1) = "Q" THEN YY=YY+1:XX=XX+1:GOTO 1010
  76. 740 IF TEXTMODEFLAG THEN 3140
  77. 750 '   IF COMMAND ENTERED IS SMALL CASE MAKE IT LARGE.
  78. 760 IF ASC(CMD$)>96 AND ASC(CMD$)<123 THEN CMD$=CHR$(ASC(CMD$)-32)
  79. 770 IF CMD$ = "-" THEN PALETTE=0:COLOR BACKCOLOR,PALETTE
  80. 780 IF CMD$ = "=" THEN PALETTE=1:COLOR BACKCOLOR,PALETTE
  81. 790 IF CMD$ = "0" THEN CUSCOL = 0
  82. 800 IF CMD$ = "1" THEN CUSCOL = 1
  83. 810 IF CMD$ = "2" THEN CUSCOL = 2
  84. 820 IF CMD$ = "3" THEN CUSCOL = 3
  85. 830 IF CMD$ = "M" THEN OLDXX=XX:OLDYY=YY
  86. 840 IF CMD$ = "D" AND DDRAW = 0 THEN DDRAW = 1 : GOSUB 1170
  87. 850 IF ASC(CMD$) = 27 AND DDRAW THEN DDRAW=0 : PUT (0,0),STORARY%,PSET
  88. 860 IF CMD$ = "L" THEN GOSUB 1900
  89. 870 IF CMD$ = "P" THEN GOSUB 2000
  90. 880 IF CMD$ = "B" THEN GOSUB 2110
  91. 890 IF CMD$ = "E" THEN GOSUB 2350
  92. 900 IF CMD$ = "R" THEN GOSUB 2560
  93. 910 IF CMD$ = "C" THEN GOSUB 2260
  94. 920 IF CMD$ = "A" THEN GOSUB 2960
  95. 930 IF CMD$ = "U" THEN PUT (1,1),BEFPLEFT%,PSET : PUT (160,1),BEFPRIGHT%,PSET :     BEFCOLOR = POINT(XX,YY)
  96. 940 IF CMD$ = "T" AND DDRAW = 0 THEN PSET (XX,YY),BEFCOLOR:GET (0,0)-(32,8),        STORARY%
  97. 950 IF CMD$ = "T" THEN LOCATE 1,1:PRINT "Text";:LINE (32,0)-(32,8),BORDERCOL :      LINE (0,8)-(32,8),BORDERCOL : TEXTMODEFLAG=1 : DDRAW=0:GOTO 610
  98. 960 IF CMD$ = "S" THEN KOPY=1:GOSUB 3230
  99. 970 IF CMD$ = "K" AND KOPY THEN GOSUB 3360
  100. 980 IF CMD$ = "X" THEN GOSUB 2060
  101. 990 IF CMD$ = "H" THEN GOSUB 1200
  102. 1000 IF CMD$ = "?" THEN ERASE STORARY%,BEFPLEFT%,BEFPRIGHT%,SAVEBLOCK%:GOTO 520
  103. 1010 'Adjust so pointer does not exceed borders.
  104. 1020 IF XX>318 THEN XX=318
  105. 1030 IF YY>198 THEN YY=198
  106. 1040 IF TEXTMODEFLAG=0 AND DDRAW=0 THEN 1070
  107. 1050 IF XX>=28 AND XX<=32 AND YY<9 THEN XX=33 : GOTO 1070
  108. 1060 IF YY=8 AND XX<33 THEN YY=9
  109. 1070 IF XX<1   THEN XX=1
  110. 1080 IF YY<1   THEN YY=1
  111. 1090 'If in draw mode leave current position as is. If not, restore dot.
  112. 1100 'Save color of this position.
  113. 1110 IF DDRAW THEN 1140
  114. 1120 PRESET(LASTXX,LASTYY),BEFCOLOR
  115. 1130 BEFCOLOR = POINT(XX,YY)
  116. 1140 PSET(XX,YY),CUSCOL
  117. 1150 LASTXX = XX : LASTYY = YY
  118. 1160 GOTO 610
  119. 1170 'Check if draw mode is on or not and display appropriate message.
  120. 1180 IF DDRAW THEN PSET(XX,YY),BEFCOLOR:GET (0,0)-(32,8),STORARY% : LOCATE 1,1 :     PRINT "Draw"; : LINE (32,0)-(32,8),BORDERCOL : LINE (0,8)-(32,8),BORDERCOL
  121. 1190 RETURN
  122. 1200 ' Help menu display routine.
  123. 1210 PSET (XX,YY),BEFCOLOR
  124. 1220 ERASE SAVEBLOCK% : DIM SAVESCREEN%(8002)
  125. 1230 GET (0,0)-(319,199),SAVESCREEN%
  126. 1240 SCREEN 0,0,0 : WIDTH 80
  127. 1250 COLOR 7,1,1
  128. 1260 RESTORE:CLS:LOCATE 1,1,0:FOR I=1 TO 23:READ A$:PRINT A$:NEXT I
  129. 1270 READ A$ : PRINT A$;
  130. 1280 CMD$=INKEY$:IF CMD$="" THEN 1280
  131. 1290 IF ASC(CMD$)=27 AND PSTART%=1 THEN 510
  132. 1300 IF ASC(CMD$)=27 THEN 1360
  133. 1310 IF ASC(CMD$)<>32 THEN 1280
  134. 1320 CLS:LOCATE 1,1,0:FOR I=1 TO 23:READ A$:PRINT A$:NEXT I
  135. 1330 READ A$ : PRINT A$;
  136. 1340 CMD$=INKEY$:IF CMD$="" THEN 1340
  137. 1350 IF PSTART%=1 THEN 510
  138. 1360 CLS:SCREEN 1:COLOR BACKCOLOR,PALETTE
  139. 1370 PUT (0,0),SAVESCREEN%,PSET
  140. 1380 ERASE SAVESCREEN% : DIM SAVEBLOCK%(5) : KOPY = 0
  141. 1390 RETURN
  142. 1400 ' Data statements for help menus
  143. 1410 DATA "                     >>>     INSTRUCTION SCREEN     <<<            Page 1"
  144. 1420 DATA " ╔═════════════════════════════════════════════════════════╗"
  145. 1430 DATA " ║To move the pinpoint, on side pad, press:                ║"
  146. 1440 DATA " ║                                                         ║"
  147. 1450 DATA " ║  1, 2, 3, 4, 6, 7, 8, or 9. Ctrl-6, Ctrl-4, Ctrl-1,     ║"
  148. 1460 DATA " ║  or Ctrl-7 moves pinpoint increments of 5.              ║"
  149. 1470 DATA " ╚═════════════════════════════════════════════════════════╝"
  150. 1480 DATA " ╔════════════════════════════════════╗"
  151. 1490 DATA " ║Color control:                      ║"
  152. 1500 DATA " ║                                    ║         ╔═══════════════════════════╗"
  153. 1510 DATA " ║  Border:  'B <0, 1, 2, or 3>',     ║         ║Circles:                   ║"
  154. 1520 DATA " ║  Background:  'BB <0 thru 15> B',  ║         ║                           ║"
  155. 1530 DATA " ║  Palettes:  '-' or '=',            ║         ║  'C <radius> C' - draws  a║"
  156. 1540 DATA " ║  Pinpoint:  '1', '2', '3', or '0'. ║         ║      circle with specified║"
  157. 1550 DATA " ╚════════════════════════════════════╝         ║      radius.              ║"
  158. 1560 DATA " ╔════════════════════════════════════════════╗ ║  'CC' - draws   a   circle║"
  159. 1570 DATA " ║Lines and Boxes:                            ║ ║      thru last marked  po-║"
  160. 1580 DATA " ║                                            ║ ║      sition.              ║"
  161. 1590 DATA " ║  Use 'M' to set a marked position.         ║ ╚═══════════════════════════╝"
  162. 1600 DATA " ║  'LL' - draws a line from current position ║"
  163. 1610 DATA " ║         to last marked position.           ║   Press 'space bar' for next"
  164. 1620 DATA " ║  'LB' - draws a box; corners are current   ║   page or <Esc> to exit Help."
  165. 1630 DATA " ║         position to last marked postion.   ║"
  166. 1640 DATA " ╚════════════════════════════════════════════╝"
  167. 1650 DATA "                     >>>     INSTRUCTION SCREEN     <<<            Page 2"
  168. 1660 DATA ""
  169. 1670 DATA " ╔═══════════════════════════════════╗  ╔═══════════════════════════════════╗"
  170. 1680 DATA " ║Copying Blocks:                    ║  ║Other commands:                    ║"
  171. 1690 DATA " ║                                   ║  ║                                   ║"
  172. 1700 DATA " ║  'S' - Saves in memory the box    ║  ║  'A' - Swaps current position     ║"
  173. 1710 DATA " ║        formed by the current      ║  ║        with last marked position. ║"
  174. 1720 DATA " ║        position and last marked   ║  ║  'E' - Exits the program. Saves   ║"
  175. 1730 DATA " ║        position.                  ║  ║        the graph if desired.      ║"
  176. 1740 DATA " ║  'K' - Copies the last saved      ║  ║  'R' - Retrieves a graph saved on ║"
  177. 1750 DATA " ║        box back onto the screen   ║  ║        disk. Asks for filename.   ║"
  178. 1760 DATA " ║        in the new position of the ║  ║  'P <1, 2, 3 or 0>' - Paints in   ║"
  179. 1770 DATA " ║        current 'pinpoint'.        ║  ║        area bordered by specified ║"
  180. 1780 DATA " ╚═══════════════════════════════════╝  ║        color.                     ║"
  181. 1790 DATA "                                        ║  'D' - Puts program in DRAW mode. ║"
  182. 1800 DATA " ╔══════════════════════════════════════╝                     ╔═════════════╝"
  183. 1810 DATA " ║ 'T' - Switches program into text mode. Allows any charact- ║"
  184. 1820 DATA " ║       ers to be placed on screen; use 'ALT <ASC #>' for    ║"
  185. 1830 DATA " ║       characters not on keyboard.                          ║ Press any key"
  186. 1840 DATA " ║ 'U' - Restores graph to what it looked like before last    ║   when done."
  187. 1850 DATA " ║       'X', 'K' or 'P'.                                     ║"
  188. 1860 DATA " ║ 'X' - Saves entire screen in memory.                       ║"
  189. 1870 DATA " ║ '?' - Clears screen and starts again with blank screen.    ║"
  190. 1880 DATA " ╚════════════════════════════════════════════════════════════╝"
  191. 1890 '                          LINES OR BOXES TAKEN HERE
  192. 1900 CMD$=INKEY$:IF CMD$="" THEN 1900
  193. 1910 IF CMD$="B" OR CMD$="b" THEN 1950
  194. 1920 IF CMD$<>"L" AND CMD$<>"l" THEN 1980
  195. 1930 LINE (XX,YY)-(OLDXX,OLDYY),CUSCOL
  196. 1940 GOTO 1960
  197. 1950 LINE (XX,YY)-(OLDXX,OLDYY),CUSCOL,B
  198. 1960 PSET (XX,YY),CUSCOL : BEFCOLOR = CUSCOL
  199. 1970 CMD$=""
  200. 1980 RETURN
  201. 1990 '                          PAINTING DONE HERE
  202. 2000 CMD$=INKEY$:IF CMD$="" THEN 2000
  203. 2010 '    SAVE SCREEN BEFORE PAINTING IT.
  204. 2020 GOSUB 2060
  205. 2030 PAINT(XX,YY),CUSCOL,VAL(CMD$)
  206. 2040 BEFCOLOR = CUSCOL '     RETAIN CURRENT POSITIONS COLOR
  207. 2050 RETURN
  208. 2060 '          Option X - save screen.
  209. 2070 PRESET(LASTXX,LASTYY),BEFCOLOR
  210. 2080 GET (1,1)-(159,198),BEFPLEFT% : GET (160,1)-(318,198),BEFPRIGHT%
  211. 2090 PRESET(LASTXX,LASTYY),CUSCOL
  212. 2100 RETURN
  213. 2110 '                          BORDER DRAWER
  214. 2120 CMD$=INKEY$:IF CMD$="" THEN 2120
  215. 2130 IF CMD$<>"B" AND CMD$<>"b" THEN 2220
  216. 2140 '                          BACKGROUND COLOR
  217. 2150 CAT$ = ""
  218. 2160 CMD$=INKEY$:IF CMD$="" THEN 2160
  219. 2170 IF CMD$="B" OR CMD$="b" THEN 2200
  220. 2180 IF CMD$<"0" OR CMD$ >"9" THEN 2250
  221. 2190 CAT$=CAT$+CMD$:GOTO 2160
  222. 2200 BACKCOLOR=VAL(CAT$):COLOR BACKCOLOR,PALETTE
  223. 2210 GOTO 2250
  224. 2220 IF CMD$<>"0" AND CMD$<>"1" AND CMD$<>"2" AND CMD$<>"3" THEN GOTO 2250
  225. 2230 BORDERCOL = VAL(CMD$)
  226. 2240 LINE(0,0)-(319,199),BORDERCOL,B
  227. 2250 RETURN
  228. 2260 '                          CIRCLE DRAWER
  229. 2270 CAT$ = ""
  230. 2280 CMD$=INKEY$:IF CMD$="" THEN 2280
  231. 2290 IF CMD$=>"0" AND CMD$<="9" THEN CAT$=CAT$+CMD$:GOTO 2280
  232. 2300 IF CMD$<>"C" AND CMD$<>"c" THEN 2340
  233. 2310 RAD#=(OLDXX-XX)^2+(OLDYY-YY)^2
  234. 2320 IF CAT$="" THEN CIRCLE (XX,YY),SQR(RAD#),CUSCOL : GOTO 2340
  235. 2330 CIRCLE (XX,YY),VAL(CAT$),CUSCOL
  236. 2340 RETURN
  237. 2350 '                          SAVING/EXITING PROCESS
  238. 2360 GET (64,32)-(255,39),STORARY%
  239. 2370 LOCATE 5,9 : PRINT "Save graph (Y/N)?      :"
  240. 2380 SROW=5:SCOL=27:MAX=1:GOSUB 3430:YNRES$=DAT$
  241. 2390 IF YNRES$="N" THEN GOSUB 2490 ELSE GOSUB 2920
  242. 2400 PRESET(LASTXX,LASTYY),BEFCOLOR
  243. 2410 IF SAVRES$>"A" AND SAVRES$<"Z" THEN GOTO 2460
  244. 2420 IF SAVRES$>"a" AND SAVRES$<"z" THEN GOTO 2460
  245. 2430 LOCATE 5,9 : PRINT "    Graph not saved.    "
  246. 2440 FOR WT = 1 TO 1000 : NEXT WT
  247. 2450 GOTO 2520
  248. 2460 DEF SEG = &HB800
  249. 2470 ON ERROR GOTO 2780:ERRLX%=5:ERRLY%=9
  250. 2480 BSAVE SAVRES$,0,&H4000
  251. 2490 LOCATE 5,9 : PRINT "Resume (Y/N)?          :"
  252. 2500 SROW=5:SCOL=23:MAX=1:GOSUB 3430:YNRES$=DAT$
  253. 2510 IF YNRES$="N" THEN GOTO 3620
  254. 2520 PUT (64,32),STORARY%,PSET
  255. 2530 PRESET(LASTXX,LASTYY),CUSCOL
  256. 2540 RETURN
  257. 2550 '                          RESTORE PROCESS
  258. 2560 PSET (XX,YY),BEFCOLOR
  259. 2570 ERASE SAVEBLOCK% : DIM SAVESCREEN%(8002)
  260. 2580 GET (0,0)-(319,199),SAVESCREEN%
  261. 2590 SCREEN 0,0,0 : WIDTH 80
  262. 2600 COLOR 3,0,0:PRINT "Files on disk are:":PRINT
  263. 2610 ON ERROR GOTO 2780 : ERRLX%=CSRLIN : ERRLY%=1
  264. 2620 FILES:PRINT 
  265. 2630 PRINT "Enter filename to be restored (or just RETURN to cancel):"
  266. 2640 SROW=CSRLIN-1:SCOL=59:MAX=12:GOSUB 3430:SAVRES$=DAT$
  267. 2650 IF NOT(SAVRES$>"A" AND SAVRES$<"Z") THEN 2740
  268. 2660 IF SAVRES$=SPACE$(MAX) THEN 2740
  269. 2670 DEF SEG = &HB800
  270. 2680 ON ERROR GOTO 2780:ERRLX%=5:ERRLY%=9
  271. 2690 CLS:SCREEN 1:COLOR BACKCOLOR,PALETTE
  272. 2700 BLOAD SAVRES$,0
  273. 2710 BEFCOLOR = POINT (XX,YY)
  274. 2720 GET (1,1)-(159,198),BEFPLEFT% : GET (160,1)-(318,198),BEFPRIGHT%
  275. 2730 GOTO 2760
  276. 2740 CLS:SCREEN 1:COLOR BACKCOLOR,PALETTE
  277. 2750 PUT (0,0),SAVESCREEN%,PSET
  278. 2760 ERASE SAVESCREEN%:DIM SAVEBLOCK%(5):KOPY=0
  279. 2770 RETURN
  280. 2780 '              Error trapping routine. (For filenames.)
  281. 2790 LOCATE ERRLX%,ERRLY%
  282. 2800 IF ERR=53 THEN PRINT "  File was not found.   "
  283. 2810 IF ERR=64 THEN PRINT " Bad filename entered.  "
  284. 2815 IF ERR = 70 THEN GOTO 50000
  285. 2820 IF ERR=71 THEN PRINT "     Disk not ready.    "
  286. 2830 IF ERR=54 THEN PRINT " None Graph file error. "
  287. 2840 IF ERR<>53 AND ERR<>64 AND ERR<>61 AND ERR<>70 AND ERR<>71 AND ERR<>54 THEN PRINT "ERROR=";ERR
  288. 2850 FOR WT = 1 TO 1800 : NEXT WT
  289. 2860 IF ERL = 2480 THEN RESUME 2530
  290. 2870 IF ERL = 2620 THEN RESUME 2740
  291. 2880 IF ERL = 2700 THEN RESUME 2750
  292. 2890 GOTO 3620
  293. 2900 '                          RETRIEVE FILENAME
  294. 2910 GET (64,32)-(255,39),STORARY%
  295. 2920 LOCATE 5,9 : PRINT "Filename:              :"
  296. 2930 SROW=5:SCOL=19:MAX=12:GOSUB 3430:SAVRES$=DAT$
  297. 2940 PUT (64,32),STORARY%,PSET
  298. 2950 RETURN
  299. 2960 '          SHOW THE LAST MARKED POSITION <M> TO THE USER FOR A FEW SECONDS.
  300. 2970 OLDCOL = POINT(OLDXX,OLDYY)
  301. 2980 FOR I = 1 TO 4
  302. 2990   PSET (OLDXX,OLDYY),3-OLDCOL
  303. 3000   FOR J = 1 TO 200 : NEXT J
  304. 3010   PSET (OLDXX,OLDYY),OLDCOL
  305. 3020   FOR J = 1 TO 200 : NEXT J
  306. 3030 NEXT I
  307. 3040 PSET (XX,YY),BEFCOLOR
  308. 3050 BEFCOLOR = OLDCOL
  309. 3060 SWAP XX, OLDXX
  310. 3070 SWAP YY, OLDYY
  311. 3080 LASTXX = XX
  312. 3090 LASTYY = YY
  313. 3100 PSET (XX,YY),CUSCOL
  314. 3110 RETURN
  315. 3120 '          TEXT TYPING MODE.
  316. 3130 'Check if escape code was entered.
  317. 3140 IF ASC(CMD$) = 27 THEN PUT (0,0),STORARY%,PSET:TEXTMODEFLAG=0:GOTO 610
  318. 3150 IF XX>310 AND YY>182 THEN 1010 'If bottom left hand corner, skip.
  319. 3160 PRESET (LASTXX,LASTYY),BEFCOLOR ' Restore color
  320. 3170 IF ASC(CMD$) > 31 AND ASC(CMD$) < 127 THEN                                      ALTKEY$="" : LOCATE INT(YY/8+1),INT(XX/8+1):XX=XX+8:PRINT MID$(CMD$,1,1);:      GOTO 3220
  321. 3180 IF ASC(CMD$)<>0 THEN 1010
  322. 3190 IF ASC(MID$(CMD$,2,1))>119 AND ASC(MID$(CMD$,2,1))<129 THEN                     ALTKEY$=ALTKEY$+MID$(STR$(ASC(MID$(CMD$,2,1))-119),2,1)
  323. 3200 IF ASC(MID$(CMD$,2,1))=129 THEN ALTKEY$=ALTKEY$+"0"
  324. 3210 IF LEN(ALTKEY$)=3 AND VAL(ALTKEY$)<255 THEN LOCATE INT(YY/8+1),INT(XX/8+1):     XX=XX+8:PRINT CHR$(VAL(ALTKEY$));:ALTKEY$=""
  325. 3220 BEFCOLOR=POINT(LASTXX,LASTYY) : GOTO 1010 ' KEEP CURRENT PINPOINT COLOR
  326. 3230 '            SAVE BLOCK OPTION DONE HERE.
  327. 3240 PSET (XX,YY),BEFCOLOR
  328. 3250 X1=XX:Y1=YY:X2=OLDXX:Y2=OLDYY
  329. 3260 IF X1>X2 AND Y1>Y2 THEN SWAP X1,X2 : SWAP Y1,Y2
  330. 3270 IF NOT (X1<X2 AND Y1<Y2) THEN 3350
  331. 3280 TOTXX = X2-X1+1 : TOTYY = Y2-Y1+1
  332. 3290 ARRAYSIZE = 4 + INT((TOTXX*2+7)/8)*TOTYY
  333. 3300 ERASE SAVEBLOCK%:DIM SAVEBLOCK%(ARRAYSIZE)
  334. 3310 GET (X1,Y1)-(X2,Y2),SAVEBLOCK%
  335. 3320 PUT (X1,Y1),SAVEBLOCK%,PRESET
  336. 3330 FOR I = 1 TO 1000 : NEXT I
  337. 3340 PUT (X1,Y1),SAVEBLOCK%,PSET
  338. 3350 RETURN
  339. 3360 '         <K> - PLACE SAVED BLOCK ON SCREEN - DONE HERE.
  340. 3370 IF XX+TOTXX > 319 OR YY+TOTYY > 199 THEN 3420 'WILL IT FIT ON SCREEN??????
  341. 3380 PRESET(LASTXX,LASTYY),BEFCOLOR
  342. 3390 GET (1,1)-(159,198),BEFPLEFT% : GET (160,1)-(318,198),BEFPRIGHT%
  343. 3400 PUT (XX,YY),SAVEBLOCK%,PSET
  344. 3410 BEFCOLOR = POINT (XX,YY)
  345. 3420 RETURN
  346. 3430 'Subroutine for user input on a byte by byte basis.
  347. 3440 DAT$=SPACE$(MAX) : OFFSET = 1
  348. 3450 CMD$=INKEY$ : IF CMD$<>"" THEN 3490
  349. 3460 LOCATE SROW,SCOL-1+OFFSET,0:PRINT "-";:FOR WT=1 TO 50:NEXT
  350. 3470 LOCATE SROW,SCOL-1+OFFSET:PRINT MID$(DAT$,OFFSET,1);:FOR WT=1 TO 100:NEXT 
  351. 3480 GOTO 3450
  352. 3490 IF (MID$(CMD$,2,1)="K" OR ASC(CMD$)=8) AND OFFSET=1 THEN BEEP:GOTO 3450
  353. 3500 IF (MID$(CMD$,2,1)="K" OR ASC(CMD$)=8) THEN OFFSET=OFFSET-1:GOTO 3450
  354. 3510 IF MID$(CMD$,2,1)="M" AND OFFSET=MAX THEN BEEP:GOTO 3450
  355. 3520 IF MID$(CMD$,2,1)="M" THEN OFFSET=OFFSET+1:GOTO 3450
  356. 3530 IF CMD$=" " THEN 3570
  357. 3540 IF ASC(CMD$)=13 THEN 3610
  358. 3550 IF NOT(ASC(CMD$)>=46 AND ASC(CMD$)<=122) THEN 3450
  359. 3560 IF ASC(CMD$)>96 AND ASC(CMD$)<123 THEN CMD$=CHR$(ASC(CMD$)-32)
  360. 3570 LOCATE SROW,SCOL-1+OFFSET:PRINT MID$(CMD$,1,1); 
  361. 3580 MID$(DAT$,OFFSET)=MID$(CMD$,1,1)
  362. 3590 OFFSET=OFFSET + 1 : IF OFFSET>MAX THEN OFFSET=MAX
  363. 3600 GOTO 3450
  364. 3610 RETURN
  365. 3620 SCREEN 0 : WIDTH 80 : SYSTEM : END
  366. 50000 RESUME 50002
  367. 50002 PRINT "PC DISK is write protected"
  368. 50010 LOCATE ERRLX% + 1,ERRLY% - 10: PRINT "Copy this file to a work disk"
  369. 50020 LOCATE ERRLX% + 2,ERRLY% - 10: PRINT "and continue."
  370. 50030 FOR DELAY = 1 TO 3000: NEXT DELAY
  371. 50040  GOTO 3620
  372.